home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1995 March / PC Plus Super CD (Issue 101) (March 1995).iso / sharewar / vbaddon / vbfiles / sam4expo.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-07-08  |  5.3 KB  |  139 lines
  1. VERSION 2.00
  2. Begin Form frmExport 
  3.    Caption         =   "VB/ISAM Sample Program SAM4 -- Export to .CSV"
  4.    ClientHeight    =   975
  5.    ClientLeft      =   1155
  6.    ClientTop       =   2145
  7.    ClientWidth     =   6825
  8.    ControlBox      =   0   'False
  9.    Height          =   1380
  10.    Left            =   1095
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   975
  15.    ScaleWidth      =   6825
  16.    Top             =   1800
  17.    Width           =   6945
  18.    Begin SSPanel pnlStopButton 
  19.       BackColor       =   &H00C0C0C0&
  20.       BevelInner      =   1  'Inset
  21.       Font3D          =   0  'None
  22.       ForeColor       =   &H00FF0000&
  23.       Height          =   975
  24.       Left            =   5460
  25.       TabIndex        =   1
  26.       Top             =   0
  27.       Width           =   1365
  28.       Begin SSCommand cmdStop 
  29.          Caption         =   "Stop"
  30.          Font3D          =   0  'None
  31.          FontBold        =   0   'False
  32.          FontItalic      =   0   'False
  33.          FontName        =   "MS Sans Serif"
  34.          FontSize        =   8.25
  35.          FontStrikethru  =   0   'False
  36.          FontUnderline   =   0   'False
  37.          Height          =   795
  38.          Left            =   90
  39.          Outline         =   0   'False
  40.          Picture         =   SAM4EXPO.FRX:0000
  41.          TabIndex        =   2
  42.          Top             =   90
  43.          Width           =   1185
  44.       End
  45.    End
  46.    Begin SSPanel pnlGauge 
  47.       BackColor       =   &H00C0C0C0&
  48.       BevelInner      =   1  'Inset
  49.       FloodColor      =   &H00008000&
  50.       FloodType       =   1  'Left To Right
  51.       Font3D          =   0  'None
  52.       FontBold        =   -1  'True
  53.       FontItalic      =   0   'False
  54.       FontName        =   "MS Sans Serif"
  55.       FontSize        =   13.5
  56.       FontStrikethru  =   0   'False
  57.       FontUnderline   =   0   'False
  58.       ForeColor       =   &H00000000&
  59.       Height          =   975
  60.       Left            =   0
  61.       TabIndex        =   0
  62.       Top             =   0
  63.       Width           =   5445
  64.    End
  65. Option Explicit
  66. Dim StopFlag As Integer
  67. Sub cmdStop_Click ()
  68.     Close #ExportFileNum
  69.     Kill ExportFileName
  70.     StopFlag = True 'Main loop in Form_Activate will see this after DoEvents
  71. End Sub
  72. Sub Form_Activate ()
  73.     Dim TempString As String
  74.     Dim PKey As String
  75.     Dim CSVString As String
  76.     Dim LinesWritten As Long
  77.     Dim PercentExported As Integer
  78.     'Refresh RecordsInFile information (may have added/deleted records):
  79.     rc = VMXInfo(DatasetRefNum, DatasetInfo)
  80.     If rc <> VIS_OK Then
  81.         TellUser (INFO_ERROR)
  82.         ExitProgram 'Panic exit
  83.     End If
  84.     rc = VmxBOF(DatasetRefNum, 0)
  85.     LinesWritten = 0
  86.     PercentExported = 0
  87.     StopFlag = False    'see cmdStop
  88.     rc = VmxGet(DatasetRefNum, 0, XNEXT, "", Throwaway, PKey, ExportRecBuffer)  '"prime" the loop
  89.                 'CSVString = CSVString & "," & Format$(TempCurrency, "Standard")
  90.     Do While rc = VIS_OK
  91.         CSVString = QuoteMaybe(PKey)
  92.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.Description)
  93.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.ProductCategory)
  94.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.FileType)
  95.         CSVString = CSVString & "," & QuoteMaybe(Format$(ExportRecBuffer.BasePrice, "Standard"))
  96.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.PricingNotes)
  97.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.CatalogPage)
  98.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.CompanyName)
  99.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.Phone)
  100.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.Fax)
  101.         CSVString = CSVString & "," & QuoteMaybe(ExportRecBuffer.Comments)
  102.         CSVString = CSVString & CRLFDelim
  103.         Put #ExportFileNum, , CSVString
  104.         LinesWritten = LinesWritten + 1
  105.         PercentExported = Int((LinesWritten / DatasetInfo.RecordsInFile) * 100)
  106.         If (PercentExported - pnlGauge.FloodPercent) >= 5 Then  'Update the indicator every 5%
  107.             pnlGauge.FloodPercent = PercentExported
  108.             DoEvents    'Be nice to Windows (also listen for StopFlag)
  109.             If StopFlag = True Then
  110.                 TellUser (EXPORT_ABORTED)
  111.                 Me.Hide
  112.                 Exit Sub
  113.             End If
  114.         End If
  115.         
  116.         rc = VmxGet(DatasetRefNum, 0, XNEXT, "", Throwaway, PKey, ExportRecBuffer)
  117.     Loop
  118.     'Make sure we finished the loop because we got to the end:
  119.     If rc <> VIS_NOT_FOUND Then
  120.         MBType = MB_ICONEXCLAMATION
  121.         Msg = "VmxGet error: " & Chr$(34) & VmxReturnCode$(rc) & Chr$(34) & " ...after exporting" & Str$(LinesWritten) & " lines."
  122.         MsgBox Msg, MBType, MBTitle
  123.         Close #ExportFileNum
  124.     Else
  125.         Close #ExportFileNum
  126.         MBType = MB_ICONINFORMATION
  127.         Msg = "Export complete."
  128.         MsgBox Msg, MBType, MBTitle
  129.     End If
  130.     Me.Hide
  131. End Sub
  132. Function QuoteMaybe (SourceString As String) As String
  133.     If InStr(SourceString, ",") = 0 Then
  134.         QuoteMaybe = SourceString
  135.     Else
  136.         QuoteMaybe = Chr$(34) & SourceString & Chr$(34)   'double-quotes
  137.     End If
  138. End Function
  139.